home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / examples.arc / EXAMPL18.PRO < prev    next >
Text File  |  1986-10-07  |  798b  |  33 lines
  1. /* Program 18 */
  2. /*
  3.   Goals to enter are on page 67 of the manual.
  4. */
  5.  
  6. predicates
  7.     solve(real,real,real)
  8.     reply(real,real,real)
  9.     mysqrt(real,real,real)
  10.     equal(real,real)
  11.  
  12. clauses
  13.     solve(A,B,C) :-
  14.         D = B*B-4*A*C, reply(A,B,D), nl.
  15.  
  16.     reply(_,_,D) :- D < 0, write("No solution"), !.
  17.     reply(A,B,D) :-
  18.         D = 0, X=-B/(2*A), write("x=",X), !.
  19.     reply(A,B,D) :-
  20.         mysqrt(D,D,SqrtD),
  21.         X1 = (-B + SqrtD)/(2*A),
  22.         X2 = (-B - SqrtD)/(2*A),
  23.         write("x1 = ",X1," and x2 = ",X2).
  24.  
  25.      mysqrt(X,Guess,Root) :-
  26.         NewGuess = Guess-(Guess*Guess-X)/2/Guess,
  27.         not(equal(NewGuess,Guess)),!,
  28.         mysqrt(X,NewGuess,Root).
  29.      mysqrt(_,Guess,Guess).
  30.  
  31.      equal(X,Y) :-
  32.         X/Y > 0.99999  , X/Y < 1.00001.
  33.